Programming Languages Suite/ProgramD2.iso/Visual Database/Visual BASIC 5.0 (Ent. Edition)/Vb5ent Extractor.EXE/VB/SAMPLES/CLISRV/BOOKSALE/SERVER/SALES.CLS

Visual Basic class definition | 1996-12-06 | 7.0 KB | 244 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Sales"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim sngPubRevenue() As Single     ' Array of monthly revenue amounts
Dim sngAuthorRoyalty() As Single  ' Array of monthly royalty amounts
Dim sngBookPrice() As Single        ' Array of monthly book prices

Public Function GetAuthors() As Variant
'This routine returns the complete list of known authors.  It is provided as a service to clients
'so that they do not need to know how or where to get the data themselves.  As such, it behaves
'as a "Data Service".  Normally, Data Services would be grouped separately from Business
'Services to help avoid development and maintenance dependencies.

End Function
Public Function GetBooks(rstrAuthor As String) As Variant
'This routine returns the list of books the specified author has published.  It is provided as a service
'to clients so that they do not need to know how or where to get the data themselves.  As such, it
'behaves as a "Data Service".  Normally, Data Services would be grouped separately from Business
'Services to help avoid development and maintenance dependencies.

End Function

Public Function GetRevenue(intSalesModel As Integer, _
                              curCostPerUnit As Currency, _
                              curAdvCost As Currency, _
                              intSalesPeriod As Integer, _
                              lngUnitsPerMonth As Long, _
                              bolIsDiscount As Boolean, _
                              strBookTitle As String) As Variant

  Dim i As Integer
  Dim iOldBound As Integer
  Dim iNewBound As Integer

  gintSalesModel = intSalesModel
  gcurCostPerUnit = curCostPerUnit
  gcurAdvertisingCost = curAdvCost
  gintSalesPeriod = intSalesPeriod
  glngUnitsPerMonth = lngUnitsPerMonth

  If GetPubRevenue(strBookTitle) = False Then
      ServerMsg Error$ & " - " & Str$(Err), vbOKOnly, "GetChartData Error"
    GetRevenue = 0
    Exit Function

  End If

  If GetAuthorRoyalty() = False Then
      ServerMsg Error$ & " - " & Str$(Err), vbOKOnly, "GetChartData Error"
    GetRevenue = 0
    Exit Function

  End If

  iOldBound = UBound(sngPubRevenue)

  For i = 0 To iOldBound
    sngPubRevenue(i, 1) = sngAuthorRoyalty(i)

  Next i

  GetRevenue = sngPubRevenue()

End Function

Public Function GetAuthorRoyalty() As Boolean
Dim i As Integer

Dim cGrossMonthlySalary As Currency
Dim cTaxAmount As Currency
Dim cTotalRevenue As Currency

'Create reference to Tax Class
Dim objTax As New Taxes

frmBookSales.lblStatus(1).Caption = "Request Author Royalty..."

ReDim sngAuthorRoyalty(gintSalesPeriod)

  For i = 0 To (gintSalesPeriod - 1)
    cGrossMonthlySalary = sngPubRevenue(i, 0) * gRoyalty
    sngAuthorRoyalty(i) = cGrossMonthlySalary - _
                                    objTax.CalcNationalIncomeTax(cGrossMonthlySalary) - _
                                    objTax.CalcSalesTax(cGrossMonthlySalary, 0)

  Next i

  ' Delete Class Reference
  Set objTax = Nothing

  frmBookSales.lblStatus(1).Caption = "Calculating Author Royalty..."
  GetAuthorRoyalty = True

End Function

Public Function GetPubRevenue(strTitle As String) As Variant
Dim sn As Recordset
Dim strSQL As String
Dim i As Integer
Dim Price As Currency

'Create Class References
Dim objModel As New Model

Static strOldTitle As String
Static cUnitPrice As Currency

frmBookSales.lblStatus(0).Caption = "Request Publisher Revenue..."
frmBookSales.lblStatus(1).Caption = "Calculating Publisher Revenue..."

On Error GoTo GetRevenueError

If strTitle <> strOldTitle Then
  frmBookSales.lblStatus(1).Caption = "Fetching row " & strTitle & "..."
  strSQL = "SELECT Titles.Price " & _
                "FROM Titles " & _
                "WHERE ((Titles.Title=" & Chr$(34) & strTitle & Chr$(34) & "));"

  Set sn = gDB.OpenRecordset(strSQL, dbOpenSnapshot)
  cUnitPrice = sn.Fields("Price")

Else
  frmBookSales.lblStatus(1).Caption = "Using last values..."

End If

ReDim sngPubRevenue(gintSalesPeriod - 1, 1)
ReDim sngBookPrice(gintSalesPeriod - 1)

For i = 0 To gintSalesPeriod - 1
   sngPubRevenue(i, 0) = cUnitPrice * _
                          objModel.intGetMonthSales(i, _
                          gintSalesPeriod, _
                          gintSalesModel)
Next i

'Delete Class Reference
Set objModel = Nothing

frmBookSales.lblStatus(1).Caption = "Sending publisher revenue to client..."
GetPubRevenue = True

' Don't try to close the object if we never created the snapshot.
' sn is never defined when strTitle = strOldTitle.
  If strTitle <> strOldTitle Then
    sn.Close
    Set sn = Nothing
  End If

  strOldTitle = strTitle

  Exit Function
  If IsObject(sn) Then sn.Close
  Set sn = Nothing

GetRevenueError:
  frmBookSales.lblStatus(1).Caption = Error$ & " - " & Str$(Err)
  GetPubRevenue = False

End Function

Private Sub Class_Initialize()

On Error GoTo InitErr

  If gintInstanceCount = 0 Then
    frmBookSales.Show
    gintInstanceCount = 0
    gDBName = App.Path & "\booksale.mdb"

    frmBookSales.lblStatus(1).Caption = "Creating Workspace..."
    DoEvents

    Set gWkspc = Workspaces(0)

    frmBookSales.lblStatus(1).Caption = "opening " & gDBName & "..."
    Set gDB = gWkspc.OpenDatabase(gDBName, False)
    frmBookSales.lblStatus(1).Caption = "Awaiting command..."
  End If

  gintInstanceCount = gintInstanceCount + 1
  frmBookSales.lblInstanceCount.Caption = Format$(gintInstanceCount)

  Exit Sub

InitExit:
Screen.MousePointer = vbDefault
Exit Sub

InitErr:

  frmBookSales.lblStatus(1).Caption = Error$ & " - " & Str$(Err)

  'advanced error handling is required if the database cannot be
  'found as error 3024 would indicate.
  If Err = 3024 Then
      'set CommonDialog properties before showing
      With frmBookSales.CommonDialog1
        .DialogTitle = "Unable to find the booksale.mdb file location"
        .Filter = "(*.mdb)|*.mdb"
        .InitDir = CurDir
        .filename = ""
        .Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNPathMustExist
        .ShowOpen
        'make sure the filename is not an empty string
        If .filename <> "" Then
          'make sure that the database file returned is indeed booksale.mdb
          If Right(UCase(.filename), Len("booksale.mdb")) = "BOOKSALE.MDB" Then
            gDBName = .filename
            Set gWkspc = Workspaces(0)
          End If
          Resume
        End If
      End With
  ElseIf Err <> 0 Then ' another error
      ServerMsg Error$ & " - " & Str$(Err), vbCritical, "BookSale Server Startup Error"
      End
  End If

  Resume InitExit

End Sub



Private Sub Class_Terminate()
  gintInstanceCount = gintInstanceCount - 1
  frmBookSales.lblInstanceCount.Caption = Format$(gintInstanceCount)

  If gintInstanceCount = 0 Then
    Unload frmBookSales
  End If
End Sub